home *** CD-ROM | disk | FTP | other *** search
/ TestDrive Windows 1993 Fall / TestDrive Windows 1993 Fall.iso / dbase / samples / vendors.prg < prev   
Encoding:
Text File  |  1993-03-09  |  8.2 KB  |  254 lines
  1. ******************************************************************************
  2. * PROGRAM NAME: VENDORS.PRG
  3. *               VENDORS DATABASE SCREEN
  4. *               SAMPLE BUSINESS APPLICATION PROGRAM
  5. * LAST CHANGED: 09/25/89 09:26AM
  6. * WRITTEN BY:   Borland International Inc.
  7. ******************************************************************************
  8. *
  9. *       FILES USED:
  10. *       Database file    =  Vendors.dbf  (Vendors file)
  11. *       Index file       =  Vendors.mdx
  12. *         TAG: Vendor_id =  vendor_id  <= Master index
  13. *       External procedure file = Library.prg
  14. ******************************************************************************
  15.  
  16. * Main procedure
  17. PROCEDURE Vendors
  18.  
  19.    * Link to external procedure file of "tool" procedures
  20.    SET PROCEDURE TO Library
  21.  
  22.    * Set up database environment
  23.    DO Set_env
  24.  
  25.    SET COLOR TO &c_standard.
  26.  
  27.    * Declare variables used:
  28.    * Database memory variables
  29.    discount = 0
  30.    STORE "" TO vendor_id, vendor, address1, address2, city, state
  31.    STORE "" TO zip, phone, contact, phone_ext, terms
  32.  
  33.    * Miscellaneous variables - used to pass parameters to Library
  34.    STORE "VENDORS" TO dbf, mlist      && Standard report & mail list available
  35.    cust_rpt = "N/A"                   && No custom reports available
  36.    STORE "m->vendor_id" TO key, key1
  37.    STORE  "NONE" TO key2, key3
  38.    keyname1 = "Vendor ID:"
  39.    STORE "" TO keyname2, keyname3
  40.    list_flds = "VENDOR_ID, VENDOR, PHONE"
  41.  
  42.    * Open databases files and choose active indexes
  43.    SELECT 1
  44.    USE Vendors ORDER Vendor_id
  45.    GO TOP
  46.    * Used for area code lookup
  47.    USE Codes ORDER City IN 2
  48.  
  49.    record_num = RECNO()
  50.    DO Load_fld
  51.  
  52.    * Show data screen
  53.    CLEAR
  54.    DO Dstatus
  55.    DO Backgrnd
  56.    DO Show_data
  57.  
  58.    * Define popup menus
  59.    DO Bar_def
  60.  
  61.    * Activate main popup menu - execute user choices
  62.    SET COLOR TO &c_popup.
  63.    ACTIVATE POPUP main_mnu
  64.    DO Sub_ret
  65.    *
  66. RETURN
  67. *================= end of main procedure =====================================
  68.  
  69. *  UTILITY PROCEDURES (Proprietary to Vendors.prg)
  70.  
  71. PROCEDURE Filter
  72.    * Filter (group) data into subset
  73.    * Select subset to set up filter condition  (Y=turn on, N=abort selection,
  74.    * T=turn off). If filter is already on, set default choice to T, show 
  75.    * window. If filter is not on, set default choice to Y, show window.
  76.    choice = IIF(filters_on,"T","Y")
  77.    DO Filt_ans
  78.    IF choice = "Y"
  79.       * Start process of choosing filter condition
  80.       STORE SPACE(15) TO city,terms
  81.       STORE SPACE(2)  TO state
  82.       STORE SPACE(10) TO zip
  83.       ACTIVATE WINDOW alert
  84.          * Get users filter condition selection(s)
  85.          @   0,0 SAY "--------- ENTER FILTER CONDITION --------"
  86.          @   1,1 SAY "CITY:  " GET m->city   PICTURE "!XXXXXXXXXXXXX"
  87.          @   2,1 SAY "STATE: " GET m->state  PICTURE "!!"
  88.          @   3,1 SAY "ZIP:   " GET m->zip
  89.          @   4,1 SAY "TERMS: " GET m->terms  FUNCTION "!"
  90.          READ
  91.       DEACTIVATE WINDOW alert
  92.       * Initialize filter condition variable to null (empty)
  93.       PUBLIC subset1,subset2,subset3,subset4,subset5
  94.       subset1 = ""
  95.       * Process user's entries to build filter condition
  96.       subset2 = subset1 + IIF([] <> TRIM(m->city), ;
  97.                 [UPPER(city) = UPPER(TRIM(m->city)) .AND. ], [])
  98.       subset3 = subset2 + IIF([] <> TRIM(m->state), ;
  99.                 [state = TRIM(state) .AND. ], [])
  100.       subset4 = subset3 + IIF([] <> TRIM(m->zip), ;
  101.                 [zip = TRIM(zip) .AND. ], [])
  102.       subset5 = subset4 + IIF("" <> TRIM(m->terms), ;
  103.                 [terms = TRIM(terms) .AND. ], [])
  104.       subset = subset5
  105.       *
  106.       * Check whether data entered into subset string
  107.       IF "" = TRIM(subset)
  108.          DO Warnbell
  109.          filters_on = .F.
  110.       ELSE
  111.          * If string is not empty, truncate the .AND. from end
  112.          subset = SUBSTR(subset, 1, LEN(subset) - 6)
  113.          * Filter on entered filter string condition
  114.          SET FILTER TO &subset.
  115.          * Activate filter by moving record pointer
  116.          GO TOP
  117.          * Check whether filter condition matches any records (no match=EOF)
  118.          filters_on = .NOT. EOF()   && Filter is turned on if .T.
  119.          IF .NOT. filters_on
  120.             * Turn off filter if no matching records found
  121.             DO Warnbell
  122.             DO Show_msg WITH "No Vendor records match the filter condition"
  123.             SET FILTER TO
  124.             GO record_num
  125.          ENDIF
  126.       ENDIF
  127.    ELSE
  128.       IF choice = "T"
  129.          * If user selects "T", turn off filter
  130.          SET FILTER TO
  131.          filters_on = .F.
  132.       ENDIF
  133.    ENDIF
  134. RETURN
  135.  
  136. PROCEDURE Indexer
  137.    * Create/rebuild index
  138.    INDEX ON vendor_id TAG Vendor_id
  139.    GO TOP
  140. RETURN
  141.  
  142. PROCEDURE Init_fld
  143.    * Initialize memory variable values - for data entry
  144.    STORE SPACE(4)  TO vendor_id,phone_ext
  145.    STORE SPACE(30) TO vendor, address1, address2, contact
  146.    terms    = SPACE(15)
  147.    discount = 0
  148.    city  = SPACE(20)
  149.    state = "TN"                   && Could be any state or blank
  150.    zip   = SPACE(10)
  151.    phone = SPACE(13)
  152. RETURN
  153.  
  154. PROCEDURE Load_fld
  155.    * Copy field values from Vendors database record into memory variables
  156.    vendor_id = vendor_id
  157.    vendor    = vendor
  158.    address1  = address1
  159.    address2  = address2
  160.    city      = city
  161.    state     = state
  162.    zip       = zip
  163.    phone     = phone
  164.    contact   = contact
  165.    phone_ext = phone_ext
  166.    terms     = terms
  167.    discount  = discount
  168. RETURN
  169.  
  170. PROCEDURE Repl_fld
  171.    * Replace database fields with values of current memory variables
  172.    REPLACE vendor_id WITH m->vendor_id,vendor WITH m->vendor, ;
  173.            address1 WITH m->address1,address2 WITH m->address2, ;
  174.            city WITH m->city,state   WITH m->state, ;
  175.            zip WITH m->zip,phone WITH m->phone, ;
  176.            contact WITH m->contact,phone_ext  WITH m->phone_ext, ;
  177.            terms WITH m->terms,discount WITH m->discount
  178. RETURN
  179.  
  180. PROCEDURE Backgrnd
  181.    * Display background screen
  182.    * Draw and fill in boxes
  183.    @ 14, 5 TO 14,52        COLOR &c_red.
  184.    @  1,22 TO  3,53 DOUBLE COLOR &c_blue.
  185.    @  5, 4 TO  7,27 DOUBLE COLOR &c_red.
  186.    @  8, 4 TO 19,53        COLOR &c_red.
  187.    @  2,23 FILL TO  2,52   COLOR &c_blue.
  188.    @  6, 5 FILL TO  6,26   COLOR &c_red.
  189.    @  9, 5 FILL TO 18,52   COLOR &c_red.
  190.    * Show data
  191.    SET COLOR TO &c_data.
  192.    @  2,28 SAY "VENDORS DATABASE"
  193.    @  6, 6 SAY "VENDOR NUMBER:"
  194.    @  9, 6 SAY "NAME:"
  195.    @ 10, 6 SAY "ADDRESS:"
  196.    @ 12, 6 SAY "CITY:"
  197.    @ 13, 6 SAY "STATE:"
  198.    @ 13,30 SAY "ZIP:"
  199.    @ 15, 6 SAY "CONTACT:"
  200.    @ 16, 6 SAY "PHONE:"
  201.    @ 16,30 SAY "EXTENSION:"
  202.    @ 17, 6 SAY "TERMS:"
  203.    @ 18, 6 SAY "DISCOUNT:"
  204.    @ 18,19 SAY "%"
  205.    SET COLOR TO &c_standard.
  206. RETURN
  207.  
  208. PROCEDURE Show_data
  209.    * Show data
  210.    SET COLOR TO &c_fields.
  211.    @  6,21 SAY vendor_id
  212.    @  9,15 SAY vendor
  213.    @ 10,15 SAY address1
  214.    @ 11,15 SAY address2
  215.    @ 12,15 SAY city
  216.    @ 13,15 SAY state
  217.    @ 13,35 SAY zip
  218.    @ 15,15 SAY contact
  219.    @ 16,15 SAY phone
  220.    @ 16,41 SAY phone_ext
  221.    @ 17,15 SAY terms
  222.    @ 18,16 SAY discount  PICTURE "99"
  223.    SET COLOR TO &c_standard.
  224. RETURN
  225.  
  226. PROCEDURE Get_data
  227.    * Display data for entry
  228.    SET COLOR TO &c_data.
  229.    @  6,21 GET m->vendor_id  PICTURE  "9999" ;
  230.            VALID Duplicat(&key.) ;
  231.            ERROR "Invalid vendor ID number; please re-enter" ;
  232.            MESSAGE "Enter a four digit vendor ID number, or Esc to quit"
  233.    @  9,15 GET m->vendor    FUNCTION "!" ;
  234.            MESSAGE "Enter vendor name"
  235.    @ 10,15 GET m->address1  FUNCTION "!"
  236.    @ 11,15 GET m->address2 FUNCTION "!"
  237.    @ 12,15 GET m->city      PICTURE "!XXXXXXXXXXXXX"
  238.    @ 13,15 GET m->state     PICTURE  "!!"
  239.    @ 13,35 GET m->zip
  240.    @ 15,15 GET m->contact   FUNCTION "!" ;
  241.            MESSAGE "Enter name of vendor contact"
  242.    @ 16,15 GET m->phone     PICTURE "(999)999-9999"
  243.    @ 16,41 GET m->phone_ext PICTURE "9999" ;
  244.            MESSAGE "Enter phone extension"
  245.    @ 17,15 GET m->terms     FUNCTION "!" ;
  246.            MESSAGE "Enter vendor's terms of sale"
  247.    @ 18,16 GET m->discount  PICTURE "99" ;
  248.            MESSAGE "Enter a discount rate (max. 99)"
  249.    SET COLOR TO &c_standard.
  250.    ON KEY LABEL F9 DO Findcode WITH m->city
  251. RETURN
  252.  
  253. ****************************  END OF VENDORS.PRG  ****************************
  254.